home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / RWDEMOS.PAK / RWPDLGS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  10KB  |  340 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Resource Workshop Demo                       }
  5. {   Copyright (c) 1992 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit RWPDlgs;
  10.  
  11. interface
  12.  
  13. uses
  14.      WinProcs, WinTypes, WObjects, WinDOS, StdDlgs, RWPDemoC, Strings;
  15.  
  16. const
  17.   fsFileSpec        = fsPathName + fsExtension;
  18.   ScribbleExtension = '.SCR';
  19.   GraphExtension    = '.GRP';
  20.   TextExtension     = '.TXT';
  21. type
  22.   PRWPDialog = ^TRWPDialog;
  23.   TRWPDialog = object(TDialog)
  24.     function DialogHelp(var Msg: TMessage): integer; virtual id_First + Id_Help;
  25.   end;
  26.  
  27. type
  28.   PDlgDirectories = ^TDlgDirectories;
  29.   TDlgDirectories = object(TRWPDialog)
  30.     procedure SetupWindow; virtual;
  31.   end;
  32.  
  33. type
  34.   PFileNew = ^TFileNew;
  35.   TFileNew = object(TRWPDialog)
  36.     FileType: ^Integer;
  37.     constructor Init(AParent: PWindowsObject; var AType: Integer);
  38.     function CanClose: Boolean; virtual;
  39.     procedure SetupWindow; virtual;
  40.   end;
  41.  
  42. type
  43.   PFileOpen = ^TFileOpen;
  44.   TFileOpen = object(TRWPDialog)
  45.     Caption: PChar;
  46.     FilePath: PChar;
  47.     FileType: ^Integer;
  48.     PathName: array[0..fsPathName] of Char;
  49.     Extension: array[0..fsExtension] of Char;
  50.     FileSpec: array[0..fsFileSpec] of Char;
  51.     constructor Init(AParent: PWindowsObject; var AType: Integer;
  52.       AFilePath: PChar);
  53.     function CanClose: Boolean; virtual;
  54.     function HasWildCards(AFilePath: PChar): Boolean;
  55.     function GetExtension(AFilePath: PChar): PChar;
  56.     function GetFileName(AFilePath: PChar): PChar;
  57.     function GetFileFirst(AFilePath: PChar): PChar;
  58.     procedure HandleBGrp(var Msg: TMessage); virtual id_First + id_Graph;
  59.     procedure HandleBScr(var Msg: TMessage); virtual id_First + id_Scribble;
  60.     procedure HandleBTxt(var Msg: TMessage); virtual id_First + id_Text;
  61.     procedure HandleDList(var Msg: TMessage); virtual id_First + id_DList;
  62.     procedure HandleFList(var Msg: TMessage); virtual id_First + id_FList;
  63.     procedure HandleFName(var Msg: TMessage); virtual id_First + id_FName;
  64.     procedure SetupWindow; virtual;
  65.   private
  66.     procedure SelectFileName;
  67.     procedure UpdateButtons;
  68.     procedure UpdateFileName;
  69.     function UpdateListBoxes: Boolean;
  70.   end;
  71.  
  72. implementation
  73.  
  74. function TRwpDialog.DialogHelp(var Msg: TMessage): integer;
  75. begin
  76.   MessageBox(HWindow,'Call WinHelp here','Help',mb_OK or mb_IconInformation);
  77. end;
  78.  
  79. procedure TDlgDirectories.SetupWindow;
  80. begin
  81.   TRWPDialog.SetupWindow;
  82.   { allow only 128 characters in each combo box }
  83.   SendDlgItemMsg(id_TextDirectory, cb_LimitText, 128, 0);
  84.   SendDlgItemMsg(id_GraphicDirectory, cb_LimitText, 128, 0);
  85.   SendDlgItemMsg(id_ScribbleDirectory, cb_LimitText, 128, 0);
  86. end;
  87.  
  88. constructor TFileNew.Init(AParent: PWindowsObject; var AType: Integer);
  89. begin
  90.   TRWPDialog.Init(AParent, MakeIntResource(dlg_FileNew));
  91.   FileType := @AType;
  92. end;
  93.  
  94. function TFileNew.CanClose: Boolean;
  95. begin
  96.   CanClose := True;
  97.   if IsDlgButtonChecked(HWindow, id_Text) = 1 then
  98.     FileType^ := FileWindow
  99.   else
  100.   if IsDlgButtonChecked(HWindow, id_Scribble) = 1 then
  101.     FileType^ := ScribbleWindow
  102.   else
  103.   if IsDlgButtonChecked(HWindow, id_Graphics) = 1 then
  104.     FileType^ := GraphWindow
  105.   else
  106.     CanClose := False;
  107. end;
  108.  
  109. procedure TFileNew.SetupWindow;
  110. begin
  111.   TRWPDialog.SetupWindow;
  112.   SetFocus(GetDlgItem(HWindow, id_Text));
  113.   SendDlgItemMessage(HWindow, id_Text, bm_SetCheck, 1, 0);
  114. end;
  115.  
  116. constructor TFileOpen.Init(AParent: PWindowsObject;
  117.   var AType: Integer; AFilePath: PChar);
  118. begin
  119.   TRWPDialog.Init(AParent, MakeIntResource(dlg_Open));
  120.   Caption := nil;
  121.   FilePath := AFilePath;
  122.   FileType := @AType;
  123. end;
  124.  
  125. function TFileOpen.CanClose: Boolean;
  126. var
  127.   PathLen: Word;
  128. begin
  129.   CanClose := False;
  130.   GetDlgItemText(HWindow, id_FName, PathName, fsPathName + 1);
  131.   FileExpand(PathName, PathName);
  132.   PathLen := StrLen(PathName);
  133.   if (PathName[PathLen - 1] = '\') or HasWildCards(PathName) or
  134.     (GetFocus = GetDlgItem(HWindow, id_DList)) then
  135.   begin
  136.     if PathName[PathLen - 1] = '\' then
  137.       StrLCat(PathName, FileSpec, fsPathName);
  138.     if not UpdateListBoxes then
  139.     begin
  140.       MessageBeep(0);
  141.       SelectFileName;
  142.     end;
  143.     Exit;
  144.   end;
  145.   StrLCat(StrLCat(PathName, '\', fsPathName), FileSpec, fsPathName);
  146.   if UpdateListBoxes then Exit;
  147.   PathName[PathLen] := #0;
  148.   if GetExtension(PathName)[0] = #0 then
  149.     StrLCat(PathName, Extension, fsPathName);
  150.   AnsiLower(StrCopy(FilePath, PathName));
  151.   UpdateButtons;
  152.   if IsDlgButtonChecked(HWindow, id_Text) = 1 then
  153.     FileType^ := FileWindow
  154.   else
  155.   if IsDlgButtonChecked(HWindow, id_Scribble) = 1 then
  156.     FileType^ := ScribbleWindow
  157.   else
  158.   if IsDlgButtonChecked(HWindow, id_Graph) = 1 then
  159.     FileType^ := GraphWindow
  160.   else
  161.   begin
  162.     CanClose := False;
  163.     Exit;
  164.   end;
  165.   CanClose := True;
  166. end;
  167.  
  168. function TFileOpen.HasWildCards(AFilePath: PChar): Boolean;
  169. begin
  170.   HasWildCards := (StrScan(AFilePath, '*') <> nil) or
  171.     (StrScan(AFilePath, '?') <> nil);
  172. end;
  173.  
  174. function TFileOpen.GetFileFirst(AFilePath: PChar): PChar;
  175. var
  176.   P, Q: PChar;
  177. begin
  178.   P := GetFileName(AFilePath);
  179.   Q := StrScan(P, '.');
  180.   if Q <> nil then Q[0] := #0;
  181.   GetFileFirst := P;
  182. end;
  183.  
  184. function TFileOpen.GetExtension(AFilePath: PChar): PChar;
  185. var
  186.   P: PChar;
  187. begin
  188.   P := StrScan(GetFileName(AFilePath), '.');
  189.   if P = nil then GetExtension := StrEnd(FilePath)
  190.   else GetExtension := P;
  191. end;
  192.  
  193. function TFileOpen.GetFileName(AFilePath: PChar): PChar;
  194. var
  195.   P: PChar;
  196. begin
  197.   P := StrRScan(AFilePath, '\');
  198.   if P = nil then P := StrRScan(AFilePath, ':');
  199.   if P = nil then GetFileName := AFilePath else GetFileName := P + 1;
  200. end;
  201.  
  202. procedure TFileOpen.SetupWindow;
  203. begin
  204.   TRWPDialog.SetupWindow;
  205.   SendDlgItemMessage(HWindow, id_FName, em_LimitText, fsPathName, 0);
  206.   if Caption <> nil then SetWindowText(HWindow, Caption);
  207.   StrLCopy(PathName, FilePath, fsPathName);
  208.   StrLCopy(Extension, GetExtension(PathName), fsExtension);
  209.   if HasWildCards(Extension) then Extension[0] := #0;
  210.   if not UpdateListBoxes then
  211.   begin
  212.     StrCopy(PathName, '*.*');
  213.     UpdateListBoxes;
  214.   end;
  215.   SelectFileName;
  216. end;
  217.  
  218. procedure TFileOpen.HandleFName(var Msg: TMessage);
  219. begin
  220.   if Msg.LParamHi = en_Change then
  221.     EnableWindow(GetDlgItem(HWindow, id_Ok),
  222.       SendMessage(Msg.LParamLo, wm_GetTextLength, 0, 0) <> 0);
  223. end;
  224.  
  225. procedure TFileOpen.HandleFList(var Msg: TMessage);
  226. begin
  227.   case Msg.LParamHi of
  228.     lbn_SelChange, lbn_DblClk:
  229.       begin
  230.     DlgDirSelect(HWindow, PathName, id_FList);
  231.     UpdateFileName;
  232.     if Msg.LParamHi = lbn_DblClk then Ok(Msg);
  233.       end;
  234.     lbn_KillFocus:
  235.       SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  236.   end;
  237. end;
  238.  
  239. procedure TFileOpen.HandleDList(var Msg: TMessage);
  240. begin
  241.   case Msg.LParamHi of
  242.     lbn_SelChange, lbn_DblClk:
  243.       begin
  244.     DlgDirSelect(HWindow, PathName, id_DList);
  245.     StrCat(PathName, FileSpec);
  246.     if Msg.LParamHi = lbn_DblClk then
  247.       UpdateListBoxes else
  248.       UpdateFileName;
  249.       end;
  250.     lbn_KillFocus:
  251.       SendMessage(Msg.LParamLo, lb_SetCurSel, Word(-1), 0);
  252.   end;
  253. end;
  254.  
  255. procedure TFileOpen.HandleBScr(var Msg: TMessage);
  256. begin
  257.   StrCat(StrCopy(PathName,GetFileFirst(PathName)), ScribbleExtension);
  258.   UpdateListBoxes;
  259. end;
  260.  
  261. procedure TFileOpen.HandleBTxt(var Msg: TMessage);
  262. begin
  263.   if StrComp(GetExtension(PathName),'.') <> 0 then
  264.   begin
  265.     StrCat(StrCopy(PathName,GetFileFirst(PathName)), '.TXT');
  266.     UpdateListBoxes;
  267.   end;
  268. end;
  269.  
  270. procedure TFileOpen.HandleBGrp(var Msg: TMessage);
  271. begin
  272.   StrCat(StrCopy(PathName, GetFileFirst(PathName)), GraphExtension);
  273.   UpdateListBoxes;
  274. end;
  275.  
  276. procedure TFileOpen.SelectFileName;
  277. begin
  278.   SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
  279.   SetFocus(GetDlgItem(HWindow, id_FName));
  280. end;
  281.  
  282. procedure TFileOpen.UpdateFileName;
  283. begin
  284.   SetDlgItemText(HWindow, id_FName, AnsiLower(PathName));
  285.   SendDlgItemMessage(HWindow, id_FName, em_SetSel, 0, $7FFF0000);
  286.   UpdateButtons;
  287. end;
  288.  
  289. procedure TFileOpen.UpdateButtons;
  290. var
  291.   P: PChar;
  292.   WhichButton: Integer;
  293. begin
  294.   P := GetExtension(PathName);
  295.   if P <> nil then
  296.   begin
  297.     if StrIComp(P, ScribbleExtension) = 0 then
  298.       WhichButton := id_Scribble
  299.     else
  300.     if StrIComp(P, GraphExtension) =  0 then
  301.       WhichButton := id_Graph
  302.     else
  303.       WhichButton := id_Text;
  304.     SendDlgItemMessage(HWindow, id_Text, bm_SetCheck, 0, 0);
  305.     SendDlgItemMessage(HWindow, id_Graph, bm_SetCheck, 0, 0);
  306.     SendDlgItemMessage(HWindow, id_Scribble, bm_SetCheck, 0, 0);
  307.     SendDlgItemMessage(HWindow, WhichButton, bm_SetCheck, 1, 0);
  308.   end;
  309. end;
  310.  
  311. function TFileOpen.UpdateListBoxes: Boolean;
  312. var
  313.   Result: Integer;
  314.   Path: array[0..fsPathName] of Char;
  315. begin
  316.   UpdateListBoxes := False;
  317.   if GetDlgItem(HWindow, id_FList) <> 0 then
  318.   begin
  319.     StrCopy(Path, PathName);
  320.     Result := DlgDirList(HWindow, Path, id_FList, id_FPath, 0);
  321.     if Result <> 0 then
  322.       DlgDirList(HWindow, '*.*', id_DList, 0, $C010);
  323.   end
  324.   else
  325.   begin
  326.     StrLCopy(Path, PathName, GetFileName(PathName) - PathName);
  327.     StrLCat(Path, '*.*', fsPathName);
  328.     Result := DlgDirList(HWindow, Path, id_DList, id_FPath, $C010);
  329.   end;
  330.   if Result <> 0 then
  331.   begin
  332.     StrLCopy(FileSpec, GetFileName(PathName), fsFileSpec);
  333.     StrCopy(PathName, FileSpec);
  334.     UpdateFileName;
  335.     UpdateListBoxes := True;
  336.   end;
  337. end;
  338.  
  339. end.
  340.